Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/isam3.fr_/isam3.fr

Text File | 1995-07-05 | 39KB | 1,229 lines

VERSION 4.00
Begin VB.Form frmCustomers
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Customers"
   ClientHeight    =   3870
   ClientLeft      =   1710
   ClientTop       =   1995
   ClientWidth     =   8205
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   4560
   Left            =   1650
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3870
   ScaleWidth      =   8205
   Top             =   1365
   Width           =   8325
   Begin VB.CommandButton cmdClose
      Caption         =   "Cl&ose"
      Height          =   315
      Left            =   6720
      TabIndex        =   26
      Top             =   3300
      Width           =   1095
   End
   Begin VB.CommandButton cmdMove
      Caption         =   ">>"
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   700
         size            =   9.75
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   3
      Left            =   2400
      TabIndex        =   25
      Top             =   3300
      Width           =   495
   End
   Begin VB.CommandButton cmdMove
      Caption         =   ">"
      Default         =   -1  'True
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   700
         size            =   9.75
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   2
      Left            =   1920
      TabIndex        =   24
      Top             =   3300
      Width           =   495
   End
   Begin VB.CommandButton cmdMove
      Caption         =   "<"
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   700
         size            =   9.75
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   1
      Left            =   1380
      TabIndex        =   23
      Top             =   3300
      Width           =   555
   End
   Begin VB.CommandButton cmdMove
      Caption         =   "<<"
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   700
         size            =   9.75
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   0
      Left            =   900
      TabIndex        =   22
      Top             =   3300
      Width           =   495
   End
   Begin VB.CommandButton cmdDelete
      Caption         =   "&Delete "
      Height          =   315
      Left            =   5400
      TabIndex        =   21
      Top             =   3300
      Width           =   1095
   End
   Begin VB.TextBox txtData
      Alignment       =   2  'Center
      DataField       =   "STATE"
      DataSource      =   "Data1"
      Height          =   315
      Index           =   6
      Left            =   4800
      MaxLength       =   2
      TabIndex        =   13
      Top             =   2100
      Width           =   405
   End
   Begin VB.TextBox txtData
      DataField       =   "ZIP"
      DataSource      =   "Data1"
      Height          =   315
      Index           =   7
      Left            =   6360
      MaxLength       =   10
      TabIndex        =   15
      Top             =   2100
      Width           =   1215
   End
   Begin VB.TextBox txtData
      DataField       =   "PHONE"
      DataSource      =   "Data1"
      Height          =   315
      Index           =   8
      Left            =   1380
      MaxLength       =   14
      TabIndex        =   17
      Top             =   2580
      Width           =   1455
   End
   Begin VB.TextBox txtData
      DataField       =   "FAX"
      DataSource      =   "Data1"
      Height          =   315
      Index           =   9
      Left            =   3960
      MaxLength       =   14
      TabIndex        =   19
      Top             =   2580
      Width           =   1455
   End
   Begin VB.CommandButton cmdAdd
      Caption         =   "&Add"
      Height          =   315
      Left            =   4080
      TabIndex        =   20
      Top             =   3300
      Width           =   1095
   End
   Begin VB.TextBox txtData
      DataField       =   "CITY"
      DataSource      =   "Data1"
      Height          =   315
      Index           =   5
      Left            =   1380
      MaxLength       =   20
      TabIndex        =   11
      Top             =   2100
      Width           =   2595
   End
   Begin VB.TextBox txtData
      DataField       =   "ADDRESS2"
      DataSource      =   "Data1"
      Height          =   315
      Index           =   4
      Left            =   1380
      MaxLength       =   40
      TabIndex        =   9
      Top             =   1620
      Width           =   4215
   End
   Begin VB.TextBox txtData
      DataField       =   "ADDRESS1"
      DataSource      =   "Data1"
      Height          =   315
      Index           =   3
      Left            =   1380
      MaxLength       =   49
      TabIndex        =   7
      Top             =   1140
      Width           =   4215
   End
   Begin VB.TextBox txtData
      DataField       =   "CUSTNUM"
      DataSource      =   "Data1"
      Height          =   285
      Index           =   0
      Left            =   1965
      MaxLength       =   5
      TabIndex        =   1
      Top             =   210
      Width           =   690
   End
   Begin VB.TextBox txtData
      DataField       =   "FIRSTNAME"
      DataSource      =   "Data1"
      Height          =   315
      Index           =   2
      Left            =   5280
      MaxLength       =   20
      TabIndex        =   5
      Top             =   660
      Width           =   2595
   End
   Begin VB.TextBox txtData
      DataField       =   "LASTNAME"
      DataSource      =   "Data1"
      Height          =   315
      Index           =   1
      Left            =   1380
      MaxLength       =   20
      TabIndex        =   3
      Top             =   660
      Width           =   2595
   End
   Begin VB.Label lblFax
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Fa&x:"
      Height          =   195
      Left            =   3420
      TabIndex        =   18
      Top             =   2640
      Width           =   375
   End
   Begin VB.Label lblPhone
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Phone:"
      Height          =   195
      Left            =   660
      TabIndex        =   16
      Top             =   2640
      Width           =   615
   End
   Begin VB.Label Label3
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Zip Code:"
      Height          =   195
      Left            =   5415
      TabIndex        =   14
      Top             =   2160
      Width           =   840
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "S&tate:"
      Height          =   195
      Left            =   4170
      TabIndex        =   12
      Top             =   2160
      Width           =   525
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&City:"
      Height          =   195
      Left            =   885
      TabIndex        =   10
      Top             =   2160
      Width           =   390
   End
   Begin VB.Label lblAddress2
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Addre&ss 2:"
      Height          =   195
      Left            =   360
      TabIndex        =   8
      Top             =   1680
      Width           =   915
   End
   Begin VB.Label lblAddress1
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Addr&ess 1:"
      Height          =   195
      Left            =   360
      TabIndex        =   6
      Top             =   1200
      Width           =   915
   End
   Begin VB.Label lblCustomerNumber
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Customer &Number:"
      Height          =   195
      Left            =   300
      TabIndex        =   0
      Top             =   240
      Width           =   1560
   End
   Begin VB.Label lblFirst
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&First Name:"
      Height          =   195
      Left            =   4200
      TabIndex        =   4
      Top             =   720
      Width           =   975
   End
   Begin VB.Label lblLast
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Last Name:"
      Height          =   195
      Left            =   300
      TabIndex        =   2
      Top             =   720
      Width           =   975
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFilePrint
         Caption         =   "&Print"
      End
      Begin VB.Menu mnuFileSep
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu mnuSeek
      Caption         =   "&Seek..."
   End
   Begin VB.Menu mnuIndex
      Caption         =   "&Index"
      Begin VB.Menu mnuIndexCustomerNumber
         Caption         =   "&Customer Number"
      End
      Begin VB.Menu mnuIndexName
         Caption         =   "&Name"
      End
      Begin VB.Menu mnuIndexState
         Caption         =   "&State"
      End
      Begin VB.Menu mnuIndexZipCode
         Caption         =   "&Zip Code"
      End
      Begin VB.Menu mnuIndexSep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuIndexNaturalOrder
         Caption         =   "Natural &Order"
      End
      Begin VB.Menu mnuIndexSep2
         Caption         =   "-"
      End
      Begin VB.Menu mnuIndexListindexes
         Caption         =   "&List Indexes"
      End
   End
End
Attribute VB_Name = "frmCustomers"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

' DataChanged is used to keep track of whether a form needs to be saved.
' It is set at false by the first call to DisplayRecord. All text box Change
' events set it true. When a record is saved or a new record is displayed,
' it is reset back to false.

Private DataChanged As Boolean

' db is the database variable, declared at form level. It is Set to
' the correct directory in the Form Load event.

Private db As DATABASE

' rs is the customer recordset. It is Set to the CUSTOMER.DBF
' table in the Form_Load event.

Private rs As Recordset

' We use a control array for the text boxes. The following constants are
' used to make the array index numbers meaningful.

Private Const CUSTNUM = 0
Private Const LASTNAME = 1
Private Const FIRSTNAME = 2
Private Const ADDRESS1 = 3
Private Const ADDRESS2 = 4
Private Const CITY = 5
Private Const STATE = 6
Private Const ZIPCODE = 7
Private Const PHONE = 8
Private Const FAX = 9
Private Sub Form_Load()
    Dim dbName As String

    ' Set the two data access object variables that were declared at
    ' module level.

    ' Get the database name and open the database.
    dbName = DataPath() & "\CHAPTER.05" ' DataPath() is in READINI.BAS
    Set db = DBEngine.Workspaces(0).OpenDatabase _
     (dbName, False, False, "dBase IV;")

    Set rs = db.OpenRecordset("CUSTOMER", dbOpenTable)

    UpdateMenuStatus "NATURAL"

End Sub

Private Sub Form_Activate()

    ' If there are no records in the table, then both beginning-of-file (BOF)
    ' and end-of-file (EOF) are True. If this is true, call EmptyRecordset,
    ' which gives the user a choice between adding a new blank record and
    ' terminating the program.

    If rs.BOF And rs.EOF Then EmptyRecordset

    ' Display the first record in the table recordset.

    DisplayRecord

End Sub

Private Sub cmdAdd_Click()

    ' The user clicked the Add button.

    Dim currentIndex As String

    ' Store the current index method and then turn on Natural Order.
    ' This is necessary to display the new blank record as soon as it's been
    ' added, because adding the record does not automatically point the
    ' record pointer at it, and when an index is active the position of the
    ' new record will be unpredictable. When no index is active, the new
    ' record will always be at the end of the record set.

    currentIndex = GetCurrentIndexState()

    ' Use the menu click event to change to natural order (i.e., no index).

    mnuIndexNaturalOrder_Click

    With rs

        ' Prepare to add a new blank record.

        .AddNew

        ' Now actually add the record.

         .UPDATE

        ' Move to the new record

       .MoveLast

    End With

    ' Restore the index that was in effect at the beginning of the procedure.

    Select Case currentIndex

        ' If no index was in effect, just display the current record.
        ' Otherwise, reset the index with the appropriate menu click routine.
        ' The menu click routine takes care of setting the record pointer back to the
        ' newly created record and refreshing the form.

        Case "NATURAL"
            DisplayRecord
        Case "CUSTNUM"
            mnuIndexCustomerNumber_Click
        Case "NAME"
            mnuIndexName_Click
        Case "STATE"
            mnuIndexState_Click
        Case "ZIPCODE"
             mnuIndexZipCode_Click
   End Select

   ' Display the new record for user entry.

    DisplayRecord

End Sub

Private Sub cmdDelete_Click()

    ' Get confirmation that the user wants to delete the current record.

   If MsgBox("Do you want to delete " & MakeName(CStr(txtData(LASTNAME)), _
   CStr(txtData(FIRSTNAME))) & "?", vbQuestion + vbYesNo + vbDefaultButton2) _
    = vbYes Then

        ' Delete the record
        ' To remove the record from the active set, the line "Deleted=On"
        ' must appear in the [dBase ISAM] section of VB.INI or the
        ' application's INI file. See How-To 4.1 for details.

        ' If the user deleted the only record in the database, call the
        ' EmptyRecordset procedure to give the user a chance to add a new
        ' blank record. If the user chooses not to add a new record,
        ' EmptyRecordset terminates the program.

        rs.DELETE

        ' If the user deleted the only record in the database, call the
        ' EmptyRecordset procedure to give the user a chance to add a new
        ' blank record. If the user chooses not to add a new record,
        ' EmptyRecordset terminates the program.

        If rs.BOF And rs.EOF Then
            EmptyRecordset

        Else

            ' After a delete, the recordset has no current record. So move
            ' to the next record in the recordset.

            rs.MoveNext

            ' If the user deleted the record that was positioned
            ' at the end of the database, move to the previous record. Since
            ' we checked earlier for an empty database, we know there must
            ' a previous record.

            If rs.EOF Then rs.MovePrevious

            ' Display the new current record.

            DisplayRecord

        End If

    End If

End Sub

Private Sub cmdClose_Click()

    Unload frmCustomers

End Sub

Private Sub cmdMove_Click(Index As Integer)

    ' The user clicked one of the navigation buttons - First, Prev, Next, or
    ' Last. Since these buttons are a control array, the specific button
    ' clicked is passed in the Index argument.

    Dim performMove As Integer
    Const MOVE_FIRST = 0
    Const MOVE_PREVIOUS = 1
    Const MOVE_NEXT = 2
    Const MOVE_LAST = 3

    ' Set the performMove flag to its default value

    performMove = True

    ' If the data have changed since the last time the record was saved, save
    ' the record. If the save is successful, performMove will remain True;
    ' otherwise, it will be set to False.

    If DataChanged Then performMove = SaveRecord()

    ' If the data have not changed or the save operation was successful, then
    ' change to the specified record.

    If performMove = True Then
        Select Case Index
            Case MOVE_NEXT

                ' Check to make sure the record pointer's not at EOF. Without
                ' this, an error would occur if the pointer was at EOF.

                If Not rs.EOF Then

                    ' Okay to move to the next record.

                    rs.MoveNext

                    ' Now did the move put the pointer at EOF? If so, there's
                    ' no current record, and several other routines assume
                    ' there's always a current record. So if the pointer's at
                    ' EOF, move it back to where it was.

                    If rs.EOF Then rs.MovePrevious
                End If
            Case MOVE_PREVIOUS

                ' Check to make sure the record pointer's not at BOF. Without
                ' this, an error would occur if the pointer was at BOF.

                If Not rs.BOF Then

                    ' Okay to move to the previous record.

                    rs.MovePrevious

                    ' Now did the move put the pointer at BOF? If so, there's
                    ' no current record, and several other routines assume
                    ' there's always a current record. So if the pointer's at
                    ' BOF, move it back to where it was.

                    If rs.BOF Then rs.MoveNext
                End If
            Case MOVE_LAST

                ' Move the record pointer to the last record in the file.

                rs.MoveLast
            Case MOVE_FIRST

                ' Move the record pointer to the first record in the file.

                rs.MoveFirst
        End Select

        ' Show the record the record pointer's currently pointing at.

        DisplayRecord
    End If
End Sub

Sub EmptyRecordset()

    ' Gives the user a chance to add a record to the data base. If the user
    ' elects not to add a record, the program terminates.

    Dim msg1 As String, msg2 As String, msg3 As String

    msg1 = "There are no customer records in the data base. "
    msg2 = "Do you want to add a new blank record? "
    msg3 = "(If you answer no, the program will terminate.)"
    If MsgBox(msg1 & msg2 & msg3, vbQuestion + vbYesNo) = vbYes Then
        cmdAdd_Click
    Else
        End
    End If

End Sub

Private Function MakeName(LASTNAME As String, FIRSTNAME As String) As String

    ' Returns a name of the form First Last, compensating for the
    ' possibility that either first or last name may be a zero-length string.

    Dim nm As String

    nm = FIRSTNAME & IIf(FIRSTNAME <> "", " ", "") & LASTNAME
    MakeName = IIf(nm = "", "the current record", nm)

End Function

Private Sub DisplayField(txt As TextBox, fieldName As String)

    ' If fieldName is not null, displays the contents of the field in the
    ' text box. If the field is null, displays an empty string.

    txt = IIf(Not IsNull(rs(fieldName)), rs(fieldName), "")

End Sub

Private Sub DisplayRecord()

    ' This procdeure displays the current record by calling DisplayField for
    ' for each text box control on the form.

    DisplayField txtData(CUSTNUM), "CUSTNUM"
    DisplayField txtData(LASTNAME), "LASTNAME"
    DisplayField txtData(FIRSTNAME), "FIRSTNAME"
    DisplayField txtData(ADDRESS1), "ADDRESS1"
    DisplayField txtData(ADDRESS2), "ADDRESS2"
    DisplayField txtData(CITY), "CITY"
    DisplayField txtData(STATE), "STATE"
    DisplayField txtData(ZIPCODE), "ZIPCODE"
    DisplayField txtData(PHONE), "PHONE"
    DisplayField txtData(FAX), "FAX"

    txtData(CUSTNUM).SetFocus

    ' DataChanged is set to true by the Change event of every text box
    ' which fires in every DisplayField routine. Set it false now because
    ' the data have not changed since the last save.

    DataChanged = False
End Sub

Private Function SaveRecord()

    ' This procedure saves the current record to he data base file. If it is
    ' successful, it returns True. If an error occurs, it returns False.

    On Error GoTo SaveRecordError

    With rs

        ' Move the record into the edit buffer.

        .Edit

        ' Now set the data fields from the text boxes on the form.

        !CUSTNUM = txtData(CUSTNUM)
        !LASTNAME = txtData(LASTNAME)
        !FIRSTNAME = txtData(FIRSTNAME)
        !ADDRESS1 = txtData(ADDRESS1)
        !ADDRESS2 = txtData(ADDRESS2)
        !CITY = txtData(CITY)
        !STATE = UCase$(txtData(STATE))
        !ZIPCODE = txtData(ZIPCODE)
        !PHONE = txtData(PHONE)
        !FAX = txtData(FAX)

        ' Now update the data base. If you forget this step you'll accomplish
        ' nothing - and no error message to warn you! If an error occurs
        ' before this step is reached, the data will not be saved, since the
        ' error-handling routine exits from the function.

         .UPDATE

    End With

    ' Set the module-level variable DataChanged to false.

    DataChanged = False

    ' Return True to indicated that the data were saved successfully.

    SaveRecord = True

Exit Function

SaveRecordError:

    ' If an error code 13 (Type Mismatch) caused the error, the error must be
    ' in the Customer Number field which requires a numeric value (all the
    ' other text boxes are saved to text fields and they will take anything),
    ' so display a meaningful error message.

    If Err = 13 Then
        MsgBox "The Customer Number field must contain a numeric value.", _
        vbExclamation
        txtData(CUSTNUM).SetFocus
    Else

        ' Not error 13, so just pass through Visual Basic's error message.

        MsgBox Error(Err)
    End If

    ' Return False to indicated that the data were not saved successfully.

    SaveRecord = False

Exit Function

End Function

Private Sub txtData_Change(Index As Integer)
    DataChanged = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    ' This event is evoked automatically before the program is unloaded.
    ' If the UnloadMode argument indicates that the cause of the unload
    ' request is from the Windows Task Manager's End Task command or from a
    ' command to exit from Windows, then the procedure calls ExitProgram().
    ' If the current record need not be saved or if the current record is
    ' saved without error, ExitProgram() simply Ends; otherwise, it returns
    ' False. The False is converted to a True, which is returned to the
    ' calling program by assigning it to the Cancel argument. Since setting
    ' Cancel to any non-zero value cancels the event, this prevents the
    ' program from being terminated.

    ' If the cause of the Unload query is the user choosing Close or closing
    ' through the Control menu, ExitProgram() is called from the Form_Unload
    ' or mnuFileExit_Click procedure, so there's no need to duplicate the call
    ' here.

    Const TASKMANAGER = 2
    Const EXITWINDOWS = 3

    If UnloadMode = TASKMANAGER Or UnloadMode = EXITWINDOWS Then
        Cancel = Not ExitProgram()
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)

    ' Calls the ExitProgram routine, which saves the current record if it's
    ' been changed, then executes an End statement.

    If ExitProgram() = False Then Cancel = True
End Sub

Private Sub mnuFileExit_Click()

    ' The user clicked Exit on the File menu or pressed Ctrl-Q.

    ' Calls the ExitProgram routine which saves the current record if it's
    ' been changed, then executes an End statement. If the save fails,
    ' ExitProgram does not execute the End, but instead returns a False.
    ' This procedure just ignores the return value and does nothing if
    ' the program cannot exit.

    ExitProgram

End Sub

Private Function ExitProgram() As Boolean

    ' This routine is called from the mnuFileExit_Click event and from the
    ' Form_Unload event. This gives the application consistent behavior no
    ' matter how the user exits from the program. If the current record does
    ' not need saving or if it's saved successfully, the function Ends the
    ' program. If the current record is not saved successfully, the function
    ' returns a False.

    If DataChanged Then
        If SaveRecord() = True Then
            End
        Else
            ExitProgram = False
        End If
    Else
        End
    End If
End Function

Private Function GetCurrentIndexState() As String

    ' This function returns the name of the currently active index.
    ' It determines the index by seeing which Index menu item is checked.

    If mnuIndexCustomerNumber.Checked Then
        GetCurrentIndexState = "CUSTNUM"
    ElseIf mnuIndexState.Checked Then
        GetCurrentIndexState = "STATE"
    ElseIf mnuIndexZipCode.Checked Then
        GetCurrentIndexState = "ZIPCODE"
    ElseIf mnuIndexName.Checked Then
        GetCurrentIndexState = "NAME"
    Else
        GetCurrentIndexState = "NATURAL"
    End If
End Function

Private Sub mnuFilePrint_Click()

    ' This procedure dumps the current database to the default Windows printer.
    ' If an index is active, the printout is sorted by the index.

    ' The currentRecord variable is used to hold the bookmark position.

    Dim currentRecord As Variant

    ' These constants are used to set the printer margins. They are in twips
    ' (1 twip = 1/LEFT_MARGIN in.). The values shown will give an LaserJet
    ' printer 1" margins. Change them to suit your preferences.

    Const LEFT_MARGIN = 1080
    Const TOP_MARGIN = 1080

    On Error GoTo PrintError

    ' Verify that the database supports bookmarks. If it does, bookmark the
    ' current record so that it can be restored as the active record after
    ' the print job has been sent to the Print Manager.

    If rs.Bookmarkable Then
        currentRecord = rs.Bookmark
    End If

    ' Show the hourglass.

    Screen.MousePointer = 11

    ' Set the top margin.

    Printer.CurrentY = TOP_MARGIN

    ' Go to the first record. Cycle through all the records until the end of
    ' the file is reached.

    rs.MoveFirst
    Do While Not rs.EOF

        ' Print the customer number at the left margin. The prompt gets printed
        ' whether or not there's anything in the field.

        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "Customer Number: " & IIf(IsNull(rs("CUSTNUM")), "", _
         Format$(rs("CUSTNUM")))

        ' Print Lastname, Firstname at the left margin.

        Printer.CurrentX = LEFT_MARGIN
        If Not IsNull(rs("LASTNAME")) Then Printer.Print rs("LASTNAME") & ", ";
        Printer.Print IIf(IsNull(rs("FIRSTNAME")), "", rs("FIRSTNAME"))
        Printer.CurrentX = LEFT_MARGIN

        ' If there's an Address1, print it at the left margin.

        If Not IsNull(rs("ADDRESS1")) Then Printer.Print rs("ADDRESS1")
        Printer.CurrentX = LEFT_MARGIN

        ' If there's an Address2, print it at the left margin.

        If Not IsNull(rs("ADDRESS2")) Then Printer.Print rs("ADDRESS2")
        Printer.CurrentX = LEFT_MARGIN

        ' Print City, State Zip at the left margin.

        If Not IsNull(rs("CITY")) Then Printer.Print rs("CITY") & ", ";
        If Not IsNull(rs("STATE")) Then Printer.Print rs("STATE") & " ";
        Printer.Print IIf(IsNull(rs("ZIPCODE")), "", rs("ZIPCODE"))
        Printer.CurrentX = LEFT_MARGIN

        ' If there's a phone number, print it at the left margin.

        If Not IsNull(rs("PHONE")) Then Printer.Print "Phone: " & rs("PHONE")
        Printer.CurrentX = LEFT_MARGIN

        ' If there's a fax number, print it at the left margin.

        If Not IsNull(rs("FAX")) Then Printer.Print "Fax: " & rs("FAX")

        ' Insert a blank line.

        Printer.Print

        ' Move to the next record

        rs.MoveNext
    Loop

    ' All done, so tell Print Manager to do its thing.

    Printer.EndDoc

    ' If a bookmark was set earlier, restore the bookmarked record. Otherwise,
    ' display the first record in the data base.

    If rs.Bookmarkable Then
        rs.Bookmark = currentRecord
    Else
        rs.MoveFirst
    End If

    ' Restore the default mouse cursor.

    Screen.MousePointer = 0

Exit Sub

PrintError:

    MsgBox Error(Err)

Exit Sub
End Sub

Private Sub ActivateIndex(whichIndex As String)

    ' This procedure is also called from the mnuIndex* routines to set
    ' the designated index.

    Dim currentRecord As Variant
    Dim performChange As Integer

    ' Initialize the performChange flag to True.

    performChange = True

    ' If the current record has been changed since the last save, save it.
    ' If the save is successful, then performChange remains True; otherwise,
    ' it is set to False. If performChange is True, go ahead and change the
    ' index.

    If DataChanged Then performChange = SaveRecord()
    If performChange = True Then

        ' If the database file type supports bookmarks, set a bookmark at the
        ' current record so that it can be restored as the current record
        ' after the index has been changed.

        If rs.Bookmarkable Then currentRecord = rs.Bookmark

        ' Set the index.

        rs.Index = whichIndex

        ' Check the menu item on the Index menu and enable the Seek menu.

        UpdateMenuStatus whichIndex

        ' If a bookmark was set earlier, use it to redisplay the same record.

        If rs.Bookmarkable Then rs.Bookmark = currentRecord

        ' Make sure the current record is the one displayed on the form.

        DisplayRecord
    End If
End Sub

Private Sub mnuIndexCustomerNumber_Click()

    ' The user chose the Customer Number selection from the index menu.
    ' This procedure is also called from the cmdAdd_Click routine to reset
    ' the index after a record has been added.

    ActivateIndex "CUSTNUM"

End Sub

Private Sub mnuIndexListIndexes_Click()

    ' This procedure displays a message box that lists all the indexes for
    ' the current database along with the fields in each index.

    Dim numIndexes As Integer
    Dim currentIndex As Integer
    Dim indexList As String

    ' Use the Count property of the Indexes collection of the recordset
    ' to find the number of indexes in the collection.

    numIndexes = rs.Indexes.Count

    ' Make sure there's at least one index.

    If numIndexes > 0 Then

        ' Cycle through the indexes in the collection.
        ' The first index is numbered 0.

        For currentIndex = 0 To numIndexes - 1

            ' Build the indexList string by appending information about the
            ' current index to the current contents of the indexList variable.
            ' For each index, the string will show the index number, index
            ' name, and the fields that make up the index.
            ' Each index entry is followed by a CRLF combination.

            indexList = indexList & Format$(currentIndex) & ": " & _
             rs.Indexes(currentIndex).Name & " (" & _
             rs.Indexes(currentIndex).Fields & ")" & Chr$(13) & Chr$(10)

        Next currentIndex

        ' Display the index list in a standard message box.

        MsgBox indexList, vbInformation, "CUSTOMER Table Index List"
    End If

End Sub

Private Sub mnuIndexName_Click()

    ' The user chose the Name selection from the index menu.
    ' This procedure is also called from the cmdAdd_Click routine to reset
    ' the index after a record has been added.

    ActivateIndex "NAME"


End Sub

Private Sub mnuIndexNaturalOrder_Click()

    ' The user chose the Natural Order selection from the index menu.
    ' This procedure is also called from the cmdAdd_Click routine to turn off
    ' the index prior to adding a record.

    Dim currentRecord As Variant
    Dim performChange As Integer

    ' Initialize the performChange flag to True.

    performChange = True

    ' If the current record has been changed since the last save, save it.
    ' If the save is successful, then performChange remains True; otherwise,
    ' it is set to False.
    ' If performChange is True, go ahead and change the index.

    If DataChanged Then performChange = SaveRecord()
    If performChange = True Then

        ' If the database file type supports bookmarks, set a bookmark at the
        ' current record so that it can be restored
        ' as the current record after the index has been changed.

        If rs.Bookmarkable Then currentRecord = rs.Bookmark

        ' Set the record order to natural order by setting the index to an
        ' empty string.

        rs.Index = ""

        ' Check the Natural Order menu item on the Index menu and disable
        ' the Seek menu.

        UpdateMenuStatus "NATURAL"

        ' If a bookmark was set earlier, use it to redisplay the same record.

        If rs.Bookmarkable Then rs.Bookmark = currentRecord

        ' Make sure the current record is the one displayed on the form.

        DisplayRecord
    End If
End Sub

Private Sub mnuIndexState_Click()

    ' The user chose the State selection from the index menu.
    ' This procedure is also called from the cmdAdd_Click routine to reset the
    ' index after a record has been added.

    ActivateIndex "STATE"

End Sub

Private Sub mnuIndexZipCode_Click()

    ' The user chose the Zip Code selection from the index menu.
    ' This procedure is also called from the cmdAdd_Click routine to reset the
    ' index after a record has been added.

    ActivateIndex "ZIPCODE"

End Sub

Private Sub mnuSeek_Click()
    Dim seekWhat1 As String, seekWhat2 As String
    Dim currentIndex As String

    ' Find out what the currently active index is.

    currentIndex = GetCurrentIndexState()

    ' Get the value(s) from the user to be sought.

    If currentIndex = "CUSTNUM" Then
        seekWhat1 = InputBox$("Customer number to seek:", "Customer List")
    ElseIf currentIndex = "STATE" Then
        seekWhat1 = UCase$(InputBox$("State to seek:", "Customer List"))
    ElseIf currentIndex = "ZIPCODE" Then
        seekWhat1 = InputBox$("Zip Code to seek:", "Customer List")
        currentIndex = "ZIPCODE"
    Else
        seekWhat1 = InputBox$("Last name to seek:", "Customer List")
        seekWhat2 = InputBox$("First name to seek:", "Customer List")
        currentIndex = "NAME"
    End If

    ' Seek the requested record. The first argument to the Seek method is
    ' the type of comparison; in this case, it's an equality. The remaining
    ' arguments are the fields in the selected index.

    If currentIndex <> "NAME" Then
        rs.Seek "=", seekWhat1
    Else
        rs.Seek "=", seekWhat1, seekWhat2
    End If

    ' If the seek was successful, it points the record pointer to the first
    ' record matching the criteria. In this case, just refresh the form.
    ' If the seek was unsuccessful, inform the user.

    If Not rs.NoMatch Then
        DisplayRecord
    Else
        MsgBox "Record sought not found!", vbExclamation, "Customer List"
    End If

End Sub

Private Sub UpdateMenuStatus(ActiveIndex As String)

    ' This routine places a check mark beside the currently selected indexing
    ' method and enables/disables the Seek menu based on whether there is an
    ' index active or not. Other routines refer to the current check status
    ' of the menu to determine what index is active.

    ' Check the appropriate menu item based on the ActiveIndex argument. Uncheck all the others.

    mnuIndexCustomerNumber.Checked = IIf(ActiveIndex = "CUSTNUM", True, False)
    mnuIndexName.Checked = IIf(ActiveIndex = "NAME", True, False)
    mnuIndexZipCode.Checked = IIf(ActiveIndex = "ZIPCODE", True, False)
    mnuIndexState.Checked = IIf(ActiveIndex = "STATE", True, False)
    mnuIndexNaturalOrder.Checked = IIf(ActiveIndex = "NATURAL", True, False)

    ' If Natural Order is selected, it means no index is currently in effect.
    ' Since the Seek method requires an index to be active, gray the menu item
    ' if Natural Order is selected.

    mnuSeek.Enabled = Not mnuIndexNaturalOrder.Checked
End Sub